home *** CD-ROM | disk | FTP | other *** search
/ Aminet 41 / Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso / Aminet / gfx / edit / AmiCAD_2.06.lha / AmiCAD / ARexx / R馭駻encer.AmiCAD < prev    next >
Text File  |  2000-04-16  |  6KB  |  204 lines
  1. /* Ajout des références aux composants du type sélectionné ou spécifié
  2.    © R.Florac, Chez Corbin, 2 juin 1998, v1.00
  3.    Version 1.02, 1er juillet 1998: ajout TEST_CIRCUIT pour marquer tous les composants (oubli)
  4.    Version 1.03, 16 mars 1999: modification fonction ASKTEXT
  5.    Version 1.04, 13 avril 2000: adaptation version 2.05
  6.    Version 1.05, 16 avril 2000: ajout init ROTATE, SYMMETRY, SETSCALE.
  7.                 Amélioration placement références nouvelles.
  8.    $VER: Référencer.AmiCAD 1.05 (© R.Florac, 16/04/00) */
  9.  
  10. options results     /* indispensable pour récupérer le résultat des macros */
  11.  
  12. signal on error     /* pour l'interception des erreurs */
  13. signal on syntax
  14.  
  15. 'SELECT("Type de composant à référencer"+CHR(10)+"Résistances"+CHR(10)+"Condensateurs"+CHR(10)+"Diodes"+CHR(10)+"Transistors"+CHR(10)+"Circuits intégrés"+CHR(10)+"Tous les composants"+CHR(10)+"Composants spécifiés")'
  16. choix=result
  17. select
  18.     when choix=1 then do
  19.     reference='R'
  20.     type="Rés#?"
  21.     end
  22.     when choix=2 then do
  23.     reference='C'
  24.     type="Cond#?"
  25.     end
  26.     when choix=3 then do
  27.     reference='D'
  28.     type="Diod#?"
  29.     end
  30.     when choix=4 then do
  31.     reference='Q'
  32.     type="Transist#?"
  33.     end
  34.     when choix=5 then do
  35.     reference="CI"
  36.     type=1
  37.     'DEF TEST_CIRCUIT(N)=IF((TYPE(N)==1) & (TEST(N)==1),1,0)'
  38.     end
  39.     when choix=6 then do
  40.     'SAVEALL'
  41.     call marquer_composant('R',"Rés#?",-1)
  42.     call marquer_composant('C',"Cond#?",-1)
  43.     call marquer_composant('D',"Diod#?",-1)
  44.     call marquer_composant('Q',"Transist#?",-1)
  45.     'DEF TEST_CIRCUIT(N)=IF((TYPE(N)==1) & (TEST(N)==1),1,0)'       /*  v1.02 */
  46.     call marquer_composant('CI',1,-1)
  47.     exit
  48.     end
  49.     when choix=7 then do
  50.     'ASKTEXT("Quel est le nom des"+CHR(10)+"composants à référencer?"+CHR(10)+"Vous pouvez utiliser"+CHR(10)+"les jokers(#?) pour"+CHR(10)+"étendre la sélection","")'
  51.     type=result
  52.     if type='' then exit
  53.     'ASKTEXT("Quelle est la référence"+CHR(10)+"à donner à ces composants?","")'
  54.     reference=result
  55.     if reference='' then exit
  56.     end
  57.     otherwise exit
  58. end
  59. 'N=FIRSTSEL'; obj=result
  60. if obj>0 then do
  61.     'REQUEST("Voulez-vous marquer"+CHR(10)+"uniquement les"+CHR(10)+"objets sélectionnés?")'
  62.     choix=result
  63. end
  64. else choix=0
  65. 'SAVEALL'
  66. call marquer_composant(reference,type,choix)
  67. exit
  68.  
  69. marquer_composant: procedure
  70.     parse arg reference,type,selection
  71.     if selection<=0 then do
  72.     /* Annulation du marquage éventuel */
  73.     'UNMARK(-1)'
  74.     /* Marquage et comptage des éléments à référencer */
  75.     if type=1 then do
  76.         'SECURITY(OBJECTS+10):I=0:N=1:WHILE(N<=OBJECTS,IF(TYPE(N)==1,IF(GETDEVS(PARTNAME(N))>0,MARK(N):I=I+1,0),0),N=N+1):I'
  77.     end
  78.     else 'SECURITY(OBJECTS+10):N=0:I=0:WHILE(I=IF(I+1<=OBJECTS,FINDPART(I+1,"'type'"),0),MARK(I):N=N+1):N'
  79.     n=result
  80.     end
  81.     else do
  82.     /* Comptage des éléments déjà marqués */
  83.     if type=1 then do
  84.         'SECURITY(OBJECTS+10):I=0:N=FIRSTSEL:WHILE(N,IF(TYPE(N)==1,I=I+1,UNMARK(N)),N=NEXTSEL(N)):I'
  85.     end
  86.     else 'SECURITY(OBJECTS+10):I=0:WHILE(N,N=FINDPART(N,"'type'"):IF(N>0,IF(TEST(N)>0,I=I+1,0):N=N+1,0)):I'
  87.     n=result
  88.     end
  89.     if n=0 then do
  90.     if selection>=0 then do
  91.         'MESSAGE("Il n''y a aucun"+CHR(10)+"objet de ce type")'
  92.         exit
  93.     end
  94.     else return
  95.     end
  96.  
  97.     /* Test des références, ajout éventuel */
  98.     call test_references(type,reference)
  99.     objet=selection_objet(1,type)
  100.     do i=1 to n
  101.     'GETREF('objet')'; ref=result
  102.     if ref=0 then call ajouter_reference(objet,reference)
  103.     else do
  104.         'READTEXT('ref')'
  105.         j=right(result,length(result)-length(reference))
  106.         if j~="" then do
  107.         ref.i=1
  108.         end
  109.     end
  110.     if i<n then objet=selection_objet(objet+1,type)
  111.     end
  112.  
  113.     /* Écriture des références */
  114.     objet=selection_objet(1,type)
  115.     numref=0
  116.     do i=1 to n
  117.     if ref.i~=1 then do
  118.         numref=numref+1
  119.         do while val.numref=1
  120.         numref=numref+1
  121.         end
  122.         'R=GETREF('objet'):SETTEXT(R,READTEXT(R)+"'numref'"):GETDEVS(PARTNAME('objet'))'
  123.         if result>1 then do
  124.         'SETTEXT(R,READTEXT(R)+CHR(READDEV('objet')+64))'
  125.         end
  126.     end
  127.     if i<n then do
  128.         objet=selection_objet(objet+1,type)
  129.     end
  130.     end
  131.     return
  132. end
  133.  
  134. ajouter_reference: procedure
  135.     parse arg obj,reference
  136.     'GETPOS('obj')'
  137.     p=result
  138.     if p=1 | p=3 then do
  139.     'GETVAL('obj')'; c=result
  140.     if c~=0 then do
  141.         'COL('c')'
  142.         c=result
  143.     end
  144.     else do
  145.         'COL('obj')+WIDTH('obj')+5'; c=result
  146.     end
  147.     'LINE('obj')+HEIGHT('obj')/2'; l=result
  148.     end
  149.     else do
  150.     'COL('obj')+WIDTH('obj')/2-TXWIDTH("'reference'")'; c=result
  151.     'LINE('obj')'; l=result
  152.     end
  153.     'LINKREF('obj',WRITE("'reference'",'c','l'))'
  154.     return
  155. end
  156.  
  157. selection_objet: procedure
  158.     parse arg obj,type
  159.     if type=1 then do
  160.     'R='obj':WHILE(TEST_CIRCUIT(R)<1,R=NEXTSEL(R)):R'
  161.     end
  162.     else do
  163.     'R=FINDPART('obj',"'type'"):WHILE(TEST(R)==0,R=FINDPART(R+1,"'type'")):R'
  164.     end
  165.     return result
  166. end
  167.  
  168. /* Procédure testant et marquant les références déjà existantes */
  169. test_references: procedure expose val.
  170.     parse arg type,reference
  171.     obj=1
  172.     'ROTATE(0,0):SETSCALE(0,100,100):SYMMETRY(0,0):OBJECTS';objets=result
  173.     do while obj<=objets
  174.     if type=1 then do
  175.         'RO='obj':WHILE(IF(RO>0,TYPE(RO)<>1,0),RO=NEXTSEL(RO)):RO'; obj=result
  176.     end
  177.     else do
  178.         'FINDPART('obj',"'type'")'; obj=result
  179.     end
  180.     if obj=0 then leave
  181.     'GETREF('obj')'; ref=result
  182.     if ref>0 then do
  183.         'READTEXT('ref')'
  184.         j=right(result,length(result)-length(reference))
  185.         if j~="" then do
  186.         'VAL("'j'")'; j=result
  187.         val.j=1
  188.         end
  189.     end
  190.     obj=obj+1
  191.     end
  192.     return
  193. end
  194.  
  195. /* Traitement des erreurs, interruption du programme */
  196. syntax:
  197. erreur=RC
  198. 'MESSAGE("Script Référencer"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  199. exit
  200.  
  201. error:
  202. 'MESSAGE("Script Référencer"+CHR(10)+"Erreur en ligne 'SIGL'")'
  203. exit
  204.